home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / qbprog.EXE / MODEMBUL.BAS < prev    next >
Encoding:
BASIC Source File  |  1995-10-18  |  5.6 KB  |  214 lines
  1. 'QBASIC'de çalìƒìr
  2.  
  3. 'QBX için QBX/L QBX ƒeklinde
  4. 'QB için QB/L QB ƒeklinde
  5. '                   yüklenmelidir
  6.  
  7. 'Her Türlü modemi bulma programì
  8. 'Yapìm : Gürol Demir Aºustos 1995
  9.  
  10.  
  11. CLS
  12. COLOR 1, 7
  13. LOCATE
  14. PRINT "C.No█Adresi█IRQ No█Yapìlan iƒlem ve sonuç█Fabrika Hìzì"
  15. COLOR 7, 1
  16.  
  17. Bekle = 5:  'Portun tepki vermesini saniye cinsinden bekleme deºeri
  18.  
  19. A$ = "103F8202F8303E8402E854220642287522085228": 'Bütün portlar bu deºiƒkende
  20.                                                  'Com No+Adres+.. formatìnda
  21. FOR I = 1 TO 40 STEP 5
  22.   Port$ = MID$(A$, I, 5)
  23.   PRINT "Com"; LEFT$(Port$, 1); "  "; RIGHT$(Port$, 4); "   ??"
  24. NEXT
  25.  
  26. 'ÿnterrupt (IRQ=2,3,4,5,7   INT=A,B,C,D,F) adresleri saklanìyor
  27.   DIM Sakla(24)
  28.   DEF SEG = 0
  29.   FOR I = 40 TO 63
  30.     Sakla(I - 39) = PEEK(I)
  31.   NEXT
  32.  
  33. 'Yeni interrupt rutinleri yerleƒtiriliyor
  34.   FOR Y = 2 TO 7
  35.     IF Y <> 6 THEN
  36.       DEF SEG = &HB900
  37.       RESTORE YeniKesme
  38.       B = (Y - 2) * 20 + 11
  39.  
  40.       FOR I = B TO B + 17
  41.          READ A
  42.          POKE I, A
  43.       NEXT
  44.  
  45.       POKE B + 9, Y
  46.       DEF SEG = 0
  47.       C = 32 + Y * 4
  48.       POKE C, B
  49.       POKE C + 1, 0
  50.       POKE C + 2, 0
  51.       POKE C + 3, &HB9
  52.     END IF
  53.   NEXT
  54.  
  55. 'ÿnterrupt yazmacì (PIC) IRQ'larìn çalìƒmasì için ayarlanìyor
  56. 'IRQ6 Dìƒìnda bütün IRQ'lar aktifleƒtiriliyor.(yani IRQ2,3,4,5,7)
  57. FOR Y1 = 2 TO 7
  58.  IF Y1 <> 6 THEN
  59.    RESTORE IRQSerbest
  60.    REDIM Oku(44)
  61.    DEF SEG = VARSEG(Oku(0))
  62.  
  63.     FOR PicMask = 0 TO 44
  64.        READ D%
  65.        IF PicMask = 13 THEN D% = Y1
  66.        POKE VARPTR(Oku(0)) + PicMask, D%
  67.     NEXT PicMask
  68.  
  69.    CALL ABSOLUTE(VARPTR(Oku(0)))
  70.  END IF
  71. NEXT
  72.  
  73.  
  74. 'Port adreslerine göre aramaya baƒlìyorum.....
  75. FOR I = 1 TO 40 STEP 5
  76.  
  77.   'ÿnterruptlarìn yazacaºì offsetler temizleniyor
  78.    DEF SEG = &HB900
  79.    FOR Y = 2 TO 9
  80.        POKE Y, 0
  81.    NEXT
  82.  
  83.   COLOR 7, 1
  84.   Port$ = MID$(A$, I + 1, 4)
  85.   Port = VAL("&H" + Port$)
  86.   LOCATE VAL(MID$(A$, I, 1)) + 1, 20
  87.   PRINT "Bakìyorum"
  88.   LOCATE VAL(MID$(A$, I, 1)) + 1, 20
  89.  
  90.       IF INP(Port + 1) <> 255 THEN
  91.          'Portda bir aygìt var hìzì 14400 Bps'e ayarlanìyor
  92.          A = INP(Port + 3)
  93.          OUT Port + 3, 128
  94.          OUT Port, 115200 / 14400
  95.          OUT Port + 3, A
  96.  
  97.         'Portlarìn IRQ üretmesi için ayarlar yapìlìyor
  98.          OUT Port + 1, 3
  99.          OUT Port + 4, 11
  100.  
  101.            FOR S = 1 TO 2
  102.              B$ = "ATZ" + CHR$(13)
  103.              GOSUB Yolla
  104.            NEXT
  105.  
  106.            'ÿnterrupt offsetlerine bakìlìyor, Kesme oluƒmuƒ mu?
  107.             DEF SEG = &HB900
  108.             FOR Y = 2 TO 9
  109.                IF PEEK(Y) <> 0 THEN LOCATE VAL(MID$(A$, I, 1)) + 1, 13: PRINT "Irq="; Y: LOCATE VAL(MID$(A$, I, 1)) + 1, 20
  110.             NEXT
  111.  
  112.            GOSUB Gelen
  113.            IF INSTR(B$, "OK") = 0 THEN
  114.                PRINT "Baƒka bir aygìt var !"
  115.            ELSE
  116.                COLOR 15, 1
  117.                PRINT "Bir modem bulundu...   ";
  118.                B$ = "ATI" + CHR$(13)
  119.                GOSUB Yolla
  120.                GOSUB Gelen
  121.                IF INSTR(B$, "14400") > 1 THEN Baud$ = "14400 Bps"
  122.                IF INSTR(B$, "2400") > 1 THEN Baud$ = "2400 Bps"
  123.                IF INSTR(B$, "28000") > 1 THEN Baud$ = "28800 Bps"
  124.                IF INSTR(B$, "ERROR") > 1 THEN Baud$ = "Öºrenilemedi!"
  125.                    PRINT Baud$;
  126.                    Baud$ = LTRIM$(STR$(VAL(Baud$) * 4))
  127.                    PRINT "  Önerilen ("; Baud$; " Bps)"
  128.            END IF
  129.  
  130.            'Portlarìn IRQ üretimi kapatìlìyor
  131.             OUT Port + 1, 0
  132.             OUT Port + 4, 0
  133.       ELSE
  134.          PRINT "Hiç aygìt yok !!!"
  135.       END IF
  136. NEXT
  137. 'ÿnterrupt yazmacìna eski IRQ deºerleri iade edilecek henüz yapìlmadì
  138.  
  139. 'Eski interrupt adresleri iade ediliyor
  140.   DEF SEG = 0
  141.   FOR I = 40 TO 63
  142.     POKE I, Sakla(I - 39)
  143.   NEXT
  144.  
  145. DEF SEG
  146. END
  147.  
  148. Yolla:
  149. FOR J = 1 TO LEN(B$)
  150. A = ASC(MID$(B$, J, 1))
  151.     DO
  152.       IF (INP(Port + 5) AND 32) = 32 THEN
  153.          OUT Port, A
  154.          EXIT DO
  155.       END IF
  156.     LOOP
  157. NEXT
  158. RETURN
  159.  
  160. Gelen:
  161. B = FIX(TIMER)
  162. B$ = ""
  163. DO
  164.     IF (INP(Port + 5) AND 1) = 1 THEN
  165.          B$ = B$ + CHR$(INP(Port))
  166.     END IF
  167. IF FIX(TIMER) - B >= Bekle THEN EXIT DO
  168. IF INSTR(B$, "OK") > 0 THEN EXIT DO
  169. LOOP
  170. RETURN
  171.  
  172. 'Yeni interrupt rutini
  173. YeniKesme:
  174. DATA &H50               : 'PUSH AX
  175. DATA &H1E               : 'PUSH DS
  176. DATA &HB8, 0, &HB9      : 'MOV AX, B900
  177. DATA &H8E, &HD8         : 'MOV DS, AX
  178. DATA &H88, &H26, 2, 0   : 'MOV [0002], AH
  179. DATA &HB0, &H20         : 'MOV AL,20
  180. DATA &HE6, &H20         : 'MOV 20,AL
  181. DATA &H1F               : 'POP DS
  182. DATA &H58               : 'POP AX
  183. DATA &HCF               : 'IRET
  184.  
  185. 'ÿnterrupt Kontrol Yazmacìnìn IRQ'ya izin verme rutini
  186. IRQSerbest:
  187. DATA &H50                  : 'PUSH AX
  188. DATA &H53                  : 'PUSH BX
  189. DATA &H51                  : 'PUSH CX
  190. DATA &H1E                  : 'PUSH DS
  191. DATA &HFA                  : 'CLI
  192. DATA &HB8, 0, &HB9         : 'MOV AX,B900
  193. DATA &H8E, &HD8            : 'MOV DS,AX
  194. DATA &H31, &HC9            : 'XOR CX,CX
  195. DATA &HB1, 2               : 'MOV CL,02
  196. DATA &HBB, 1, 0            : 'MOV BX,0001
  197. DATA &HD3, &HE3            : 'SHL BX,CL
  198. DATA &HF7, &HD3            : 'NOT BX
  199. DATA &HE4, &HA1            : 'IN AL,A1
  200. DATA &HA2, 0, 0            : 'MOV [0000],AL
  201. DATA &H20, &HF8            : 'AND AL,BH
  202. DATA &HE6, &HA1            : 'OUT A1,AL
  203. DATA &HE4, &H21            : 'IN AL,21
  204. DATA &HA2, 1, 0            : 'MOV [0001],AL
  205. DATA &H20, &HD8            : 'AND AL,BL
  206. DATA &HE6, &H21            : 'OUT 21,AL
  207. DATA &HFB                  : 'STI
  208. DATA &H1F                  : 'POP DS
  209. DATA &H59                  : 'POP CX
  210. DATA &H5B                  : 'POP BX
  211. DATA &H58                  : 'POP AX
  212. DATA &HCB                  : 'RETF
  213.  
  214.